Unit BARKOD;
Interface
Type
  str9 = String[9];
  str12 = String[12];

Const
  {kntr='{0123456789x';}
  kntr = '{levent6789x';
  yorum: String[44] = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. *$/+%';
  cubuklar: Array[0..43] Of str9 = (
    '000110100', '100100001', '001100001', '101100000', '000110001',
    '100110000',
    '001110000', '000100101', '100100100', '001100100', '100001001',
    '001001001',
    '101001000', '000011001', '100011000', '001011000', '000001101',
    '100001100',
    '001001100', '000011100', '100000011', '001000011', '101000010',
    '000010011',
    '100010010', '001010010', '000000111', '100000110', '001000110',
    '000010110',
    '110000001', '011000001', '111000000', '010010001', '110010000',
    '011010000',
    '010000101', '110000100', '011000100', '010010100', '010101000',
    '010100010',
    '010001010', '000101010');

  CubukG: Array[0..3] Of byte = (4, 2, 12, 6);
  GrafMod = #27#90;
  KodArasi = 6;

Function BirBarkod(k: str12): String;

Implementation

Function Kodu(c: char): str9;
Begin
  kodu := cubuklar[pos(c, yorum) - 1];
End;

Function NoktaSayisi(k: String): word;
Var
  i: byte;
  nosa: word;
Begin
  nosa := 0;
  For i := 1 To 9 Do
    nosa := nosa + CubukG[(i Mod 2) + (ord(k[i]) - 48) * 2];
  NoktaSayisi := nosa;
End;

Function BirKod(kod1: char): String;
Var
  i, j, k: byte;
  h, x, n: byte;
  d: byte;
  ns: word;
  nsc: String[2];
  kd: String;
  b: String;
Begin
  b := '';
  h := 8;
  kd := Kodu(kod1);
  ns := NoktaSayisi(kd);
  nsc := char(ns Mod 256) + char(ns Div 256);
  b := b + GrafMod + nsc;
  For i := 1 To 9 Do
  Begin
    d := (i Mod 2) * 255;
    For k := 1 To CubukG[(i Mod 2) + (ord(kd[i]) - 48) * 2] Do
    Begin
      If h Div 8 * k = 0 Then
        x := (h Mod 8)
      Else
        x := 8;
      b := b + char(d Shl (8 - x));
    End;
  End;
  result := b;
End;

Function BirAra: String;
Var
  i: byte;
  nsc: String[2];
  b: String;
Begin
  nsc := char(KodArasi Mod 256) + char(KodArasi Div 256);
  b := GrafMod + nsc;
  For i := 1 To KodArasi Do
    b := b + #0;
  result := b;
End;

Function BirBarkod(k: str12): String;
Var
  i, n: byte;
  b: String;
Begin
  b := BirKod('*');
  b := b + BirAra;
  For n := 1 To length(k) Do
  Begin
    b := b + BirKod(k[n]);
    b := b + BirAra;
  End;
  b := b + BirKod('*');
  result := b;
End;

End.
